;;************************************************************************
;; scatter1.lsp 
;; contains code for new and revised methods for scatterplot
;; copyright (c) 1991-99 by Forrest W. Young
;;************************************************************************

  

;==============================================
; vista-scatterplot-proto
; adds vista look and feel to scatterplot proto
;==============================================


(defun scatterplot (&rest args)
"Produces scatterplot with ViSta look and feel. Same args as Plot Points."
     (let ((plot (apply #'plot-points args))
           )
       (send plot :use-color t)
       (send plot :plot-buttons :new-x nil :new-y nil :free nil)
       (send plot :point-color (iseq (send plot :num-points)) 'blue)
       (send plot :mouse-mode 'brushing)
       (send plot :x-axis t t (third (send plot :x-axis)))
       (send plot :y-axis t t (third (send plot :y-axis)))
       plot))

(defproto vista-scatterplot-proto 
  '(spreadplot-supervisor showing legend1 legend2 legend3L legend3R container connect-points)
  '() scatterplot-proto)

#|_______________________________________________________________________________
 |
 | The next version of the isnew replaces the following two versions.
 | The next version was written by fwy on December 26 2002. It allows the "new"
 | version of the isnew (written in early December, 2002) to peacefully coexist
 | with the "old" version, even though they have very different argument structures.
 |
 | They differ in whether the first argument, if there is one, is an integer.
 | The old version always needed an initial integer.  The new version does not.
 |________________________________________________________________________________
 |#

(defmeth vista-scatterplot-proto :isnew (&rest args)
"Args:  &optional data 
        &key variable-labels point-labels connect-points (connect t)
             (container nil) (show t) (top-most t) (pop-out nil)
             (location '(50 50)) (size '(300 300)) 
             (new-x t) (new-y t) (lines t)
             (menu t) (title \"Scatter Plot\") 
             (legend1 (send $ :name)) (legend2 nil)
             (go-away t) (content-only nil))
connect-points makes the plot a line-plot 
connect adds a connect button
lines controls appearance of the lines button"
  (cond
    ((and args (integerp (first args)))
     (apply #'call-next-method args)
     (send self :use-color t)
     (let* ((overlays (send self :overlays))                      ;fwy changed feb 19 2003
            (parents)
            (iflag)
            )
       (when overlays
             (dotimes (i (length overlays))
                      (setf parents (send (select overlays i) :parents))
                      (setf iflag (not (not (member vista-graph-overlay-proto 
                                                    parents :test #'equal))))))
       (if iflag 
           (message-dialog 
            "vista-scatterplot-proto :isnew (scatter1.lsp) tried to add 2nd button overlay")
           (send self :plot-buttons :new-x nil :new-y nil :free nil)))
     (send self :mouse-mode 'brushing)
     (send self :x-axis t t 5)
     (send self :y-axis t t 5)
     (send self :showing-labels t)
     (send self :legend1 (send current-object :name))
     (send self :legend2 (send self :title))
     (send self :make-two-plot-menus                               ;fwy added feb 19 2003 
           "Scatter"
           :hotspot-items '(help dash  print save copy)
           :popup-items   '(link showing-labels dash mouse resize-brush dash
                            erase-selection focus-on-selection view-selection dash 
                            select-all unselect-all show-all dash
                            symbol color dash selection slicer))
     )
    (args
     (let* ((keyword-args (rest args))
            (menu-loc)
            (num)
            (selection)
            )
       (when keyword-args
             (setf menu-loc (position ':MENU keyword-args))
             (when menu-loc 
                   (setf num (length keyword-args))
                   (setf selection (remove (1+ menu-loc) (remove menu-loc (iseq num))))
                   (setf keyword-args (select keyword-args selection))))
       (apply #'call-next-method (append (list (length (first args))) keyword-args))
       (apply #'send self :revised-vista-look-and-feel args))
     )
    (t
     (call-next-method 0)
     (apply #'send self :revised-vista-look-and-feel args)
     ))
  self)

(defmeth vista-scatterplot-proto :revised-vista-look-and-feel 
  (&optional data 
        &key variable-labels point-labels connect-points (connect t)
             (container nil) (show t) (top-most t) (pop-out nil)
             (location '(50 50)) (size '(300 300)) (new-x t) (new-y t) (lines t)
             (menu t) (title "Scatter Plot") 
             (legend1 nil) (legend2 nil)
             (go-away t) (content-only nil))
  (send self :data data)
  (send self :add-points data)
  (when connect-points (send self :add-lines data :color 'blue))
  (send self :use-color t)
  (send self :pop-out-on pop-out)
  (send self :top-most-on top-most)
  (send self :plot-buttons :new-x new-x :new-y new-y :free nil :density lines :connect connect)
  (send self :point-color (iseq (send self :num-points)) 'blue)
  (send self :mouse-mode 'brushing)
  (send self :x-axis t t (third (send self :x-axis)))
  (send self :y-axis t t (third (send self :y-axis)))
  (send self :point-label (iseq (send self :num-points)) point-labels)
  (send self :showing-labels t)
  (send self :legend1 (if legend1 
                          legend1 
                          (if current-object 
                              (send current-object :name) 
                              "Temporary")))
  (send self :legend2 (if legend2 legend2 (send self :title)))
  (send self :adjust-to-data)
  (send self :container container)
  (when show (send self :show-window))
  (send self :menu-template '(help dash new-x new-y dash print save copy))
  (send self :make-two-plot-menus 
        "Scatter"
        :hotspot-items '(help dash new-x new-y dash link dash print save copy)
        :popup-items '(showing-labels mouse resize-brush dash
                       erase-selection focus-on-selection view-selection dash 
                       select-all show-all dash
                       symbol color dash selection slicer))
  self)




(defmeth vista-scatterplot-proto :legend1 (&optional (string nil set))
  (if set (setf (slot-value 'legend1) string))
  (slot-value 'legend1))

(defmeth vista-scatterplot-proto :legend2 (&optional (string nil set))
  (if set (setf (slot-value 'legend2) string))
  (slot-value 'legend2))

(defmeth vista-scatterplot-proto :legend3L (&optional (string nil set))
  (if set (setf (slot-value 'legend3L) string))
  (slot-value 'legend3L))

(defmeth vista-scatterplot-proto :legend3R (&optional (string nil set))
  (if set (setf (slot-value 'legend3R) string))
  (slot-value 'legend3R))

(defmeth vista-scatterplot-proto :container (&optional (object nil set))
  (if set (setf (slot-value 'container) object))
  (slot-value 'container))

(defmeth vista-scatterplot-proto :connect-points (&optional (logical nil set))
"Args: (&optional logical)
Sets or returns t or nil for drawing lines connecting points."
  (when (not (send self :has-slot 'connect-points))
        (send self :add-slot 'connect-points))
  (if set (setf (slot-value 'connect-points) logical))
  (slot-value 'connect-points))

(defmeth vista-scatterplot-proto :data (&optional (stuff nil set))
"Args: (&optional logical)
Sets or returns the graph data."
  (when (not (send self :has-slot 'data))
        (send self :add-slot 'data))
  (if set (setf (slot-value 'data) stuff))
  (slot-value 'data))

(defmeth vista-scatterplot-proto :redraw-content ()
  (send self :line-type 'solid)
  (call-next-method)
  (send self :draw-color 'black)
  (send self :draw-legends)
  (send self :add-grid))

(defmeth vista-scatterplot-proto :choose-connection ()
  (cond
    ((send self :connect-points)
     (send self :clear-lines)
     (send self :connect-points nil)
     )
    (t
     (send self :connect-points t)
     (send self :add-lines (send self :data) :color 'blue))))

(defmeth scatterplot-proto :redraw-content ()
  (call-next-method)
  (when (not (send self :has-slot 'legend1)) (send self :make-legends))
  (when (equal (send self :slot-value 'proto-name)
               (send scatterplot-proto :slot-value 'proto-name))
        (send self :draw-legends))
  (when (not (equal (send self :slot-value 'proto-name)
                    (send boxplot-proto :slot-value 'proto-name)))
        (send self :add-grid)))

;(defmeth scatterplot-proto :content-rect ()
;    (let ((cr (call-next-method)))      
;      (apply #'call-next-method (+ cr (list -7 0 7 7)))))

(defmeth scatterplot-proto :add-grid ()
         (let* ((cv (send self :content-variables))
                (rangex (send self :range (first cv)))
                (rangey (send self :range (second cv)))
                (minx (first  rangex))
                (maxx (second rangex))
                (miny (first  rangey))
                (maxy (second rangey))
                (line1start (- (send self :real-to-canvas minx maxy) (list 1 5)))
                (line1end   (- (send self :real-to-canvas maxx maxy) (list 0 5)))
                (line2start (send self :real-to-canvas maxx miny))
                (line2end   (- (send self :real-to-canvas maxx maxy) (list 0 6)))
                (line3start (- (send self :real-to-canvas minx maxy) (list 1 5)))
                (line3end   (- (send self :real-to-canvas minx maxy) (list 1 0)))
                )
           (when (and line1start line1end line2start line2end)
                 (apply #'send self :draw-line 
                        (combine line1start line1end))
                 (apply #'send self :draw-line 
                        (combine line2start line2end))
                 (apply #'send self :draw-line 
                        (combine line3start line3end)))))


(defmeth scatterplot-proto :make-legends ()
  (when (not (send self :has-slot 'legend1))
        (send self :add-slot 'legend1 (send current-object :name))
        (defmeth self :legend1 (&optional (string nil set))
          (if set (setf (slot-value 'legend1) string))
          (slot-value 'legend1)))
  (when (not (send self :has-slot 'legend2))
        (send self :add-slot 'legend2 (send self :title)) ;"Scatterplot"
        (defmeth self :legend2 (&optional (string nil set))
          (if set (setf (slot-value 'legend2) string))
          (slot-value 'legend2)))
  (when (not (send self :has-slot 'legend3L))
        (send self :add-slot 'legend3L)
        (defmeth self :legend3L (&optional (string nil set))
          (if set (setf (slot-value 'legend3L) string))
          (slot-value 'legend3L)))
  (when (not (send self :has-slot 'legend3R))
        (send self :add-slot 'legend3R)
        (defmeth self :legend3R (&optional (string nil set))
          (if set (setf (slot-value 'legend3R) string))
          (slot-value 'legend3R))))

(defmeth scatterplot-proto :draw-legends ()
  (let* ((line1 (+ (second (send self :margin)) -3
                   (send self :text-ascent) (send self :text-descent)))
         (line2 (+ line1
                   (send self :text-ascent) (send self :text-descent) 1))
         (line3 (- (send self :canvas-height) 3
                   (send self :text-ascent) (send self :text-descent)))
         )
    (when (send self :legend1)
          (send self :draw-text (send self :legend1)
                (floor (/ (first (send self :size)) 2)) line1 1 0))
    (when (send self :legend2)
          (send self :draw-text (send self :legend2)
                (floor (/ (first (send self :size)) 2)) line2 1 0))
    (when (send self :legend3L)
          (send self :draw-text (send self :legend3L) 3 line3 0 1))
    (when (send self :legend3R)
          (send self :draw-text (send self :legend3R) 
                (- (send self :canvas-width) 3) line3 2 1))
    ))

#|
(defmeth scatterplot-proto :do-click (x y m1 m2)
  (let* ((menu (send self :menu))
         (hotspot-menu-items (send self :hotspot-menu-items)) 
         (popup-menu-items (send self :popup-menu-items)))
  (if m2 
      (when (and popup-menu-items (> y 18)) 
            (apply #'send menu :delete-items (send menu :items))
            (apply #'send menu :append-items popup-menu-items)
            (send menu :popup-menu x y self))
      (progn
       (apply #'send menu :delete-items (send menu :items))
       (apply #'send menu :append-items hotspot-menu-items)
       (call-next-method x y m1 m2)))))
|#

(defmeth scatterplot-proto :vista-look-and-feel ()
  (send self :plot-buttons :new-x nil :new-y nil :density t)
  (send self :title "ScatterPlot")
 ; (send self :new-menu "Scatter" 
 ;       :items '(help dash new-x new-y dash
 ;                     link dash
 ;                     show-plots hide-plots close-plots dash
 ;                     print save copy))
 ; (send self :hotspot-menu-items (send (send self :menu) :items))
 ; (send self :make-popup-menu-items
 ;       '(showing-labels mouse resize-brush dash
 ;         erase-selection focus-on-selection view-selection show-all dash
 ;         symbol color dash selection slicer))
  (send self :make-two-plot-menus 
        "Scatter"
        :hotspot-items '(help dash new-x new-y dash link dash
                               print save copy)
        :popup-items '(showing-labels mouse resize-brush dash
                       erase-selection focus-on-selection view-selection dash 
                       select-all show-all dash
                       symbol color dash selection slicer))
  (send self :showing-labels t)
  (send self :linked t)
  (send self :x-axis t t 5)
  (send self :y-axis t t 5)
  (send self :use-color t)
  (when (send self :num-points)
        (send self :point-color (iseq (send self :num-points)) 'blue))
  (send self :mouse-mode 'brushing)
  (send self :make-legends)
  )


(defmeth graph-proto :abline (a b &rest args)
"Message args: (a b)
Adds the graph of the line A + B x to the plot.
Redefined by FWY to support COLOR, WIDTH and TYPE"
  (let ((limits (send self :range 0)))
    (apply #'send self :add-function #'(lambda (x) (+ a (* b x)))
          (car limits)
          (cadr limits)
          args)))

(defmeth scatterplot-proto :show-new-var (axis variable)
  (let* ((cur-var (send self :current-variables))
         (var-num (position variable (send self :variable-labels))))
    (if (equal axis "X") 
       (send self :current-variables var-num (second cur-var) :draw nil)
       (send self :current-variables (first cur-var) var-num :draw nil))
    (send self :adjust-to-data)))

(send scatterplot-proto :menu-title "Scatter")
(send scatterplot-proto :title "Scatterplot")
      

(defmeth scatterplot-proto :center-at-centroid (&key (draw t))
"Args: DRAW
Centers plot at centroid of points, using existing scale type."
 (let* ((scale-type (send self :scale-type))
         (numpts (send self :num-points))
         (numvar (send self :num-variables))
         (ranges (send self :range (iseq 0 (- numvar 1))))
         )
    (when (or (equal scale-type 'variable) (equal scale-type 'fixed))
          (mapcar 
           #'(lambda (i)
               (send self :center i
                     (mean (send self :point-coordinate i (iseq numpts)))
                     :draw nil)) (iseq numvar))
          (when draw (send self :redraw-content)))
    nil))

(defmeth scatterplot-proto :adjust-scatterplot-to-data 
             (scale-type &key (draw t))
"Args: SCALE-TYPE DRAW
Adjust scatterplot to show data. To be used for SCALE-TYPE of centroid-fixed or centroid-variable"
  (let* ((numpts (send self :num-points))
         (numvar (send self :num-variables))
         (ranges (send self :range (iseq 0 (- numvar 1))))
         (maxrange (max (- (min ranges)) (max ranges)))
         (gnr (get-nice-range (- maxrange) maxrange 5))
         (nice-min (first gnr))
         (nice-max (second gnr)) 
         )
       (mapcar 
        #'(lambda (i)
            (send self :center i
                  (mean (send self :point-coordinate i (iseq numpts)))
                  :draw nil)) (iseq numvar))
       (cond
         ((equal scale-type 'centroid-variable)
          (mapcar 
           #'(lambda (i)
               (send self :scaled-range i (- (sqrt numvar)) (sqrt numvar)
                     :draw nil)) (iseq numvar))
          (setf gnr (get-nice-range (- (sqrt numvar)) (sqrt numvar) 5))
          (send self :range (iseq numvar) (first gnr) (second gnr) :draw nil)
          
          )
         (t
          (send self :range (iseq numvar) nice-min nice-max :draw nil)))
    (send self :x-axis t t (third gnr))
    (send self :y-axis t t (third gnr))
    (when draw
          (send self :resize)
          (send self :redraw))
    nil))
